home *** CD-ROM | disk | FTP | other *** search
/ Aminet 24 / Aminet 24 (1998)(GTI - Schatztruhe)[!][Apr 1998].iso / Aminet / dev / c / AmiVoGL_MDEV.lha / examples / fcurves.F < prev    next >
Text File  |  1991-06-07  |  5KB  |  268 lines
  1. c
  2. c using curves
  3. c
  4.     program fcurve
  5.  
  6. #ifdef SGI
  7. #include "fgl.h"
  8. #include "fdevice.h"
  9. #else
  10. #include "fvogl.h"
  11. #include "fvodevice.h"
  12. #endif
  13.  
  14.     character buf*50
  15.     real bezier(4, 4), cardin(4, 4), bsplin(4, 4)
  16.     real geom1(3, 4), geom2(3, 6)
  17.     integer *2 val
  18. c
  19. c curve basis types
  20. c
  21.     data bezier /
  22.      +      -1.0,    3.0,    -3.0,    1.0,
  23.      +      3.0,    -6.0,    3.0,    0.0,
  24.      +      -3.0,    3.0,    0.0,    0.0,
  25.      +      1.0,    0.0,    0.0,    0.0 
  26.      +  /
  27.  
  28.     data cardin /
  29.      +      -0.5,    1.5,    -1.5,    0.5,
  30.      +      1.0,    -2.5,    2.0,    -0.5,
  31.      +      -0.5,    0.0,    0.5,    0.0,
  32.      +      0.0,    1.0,    0.0,    0.0
  33.      +  /
  34.  
  35.     data bsplin /
  36.      +          -0.166666,     0.5,     -0.5,     0.166666,
  37.      +           0.5,         -1.0,      0.5,     0.0,
  38.      +          -0.5,          0.0,      0.5,     0.0,
  39.      +           0.166666,     0.666666, 0.166666, 0.0
  40.      +  /
  41.  
  42. c
  43. c Geometry matrix to demonstrate basic spline segments
  44. c
  45.     data geom1 /
  46.      +       -180.0, 10.0, 0.0,
  47.      +       -100.0, 110.0, 0.0,
  48.      +       -100.0, -90.0, 0.0,
  49.      +       0.0, 50.0, 0.0
  50.      +  /
  51.  
  52. c
  53. c Geometry matrix to demonstrate overlapping control points to
  54. c produce continuous (Well, except for the bezier ones) curves
  55. c from spline segments
  56. c
  57.     data geom2 /
  58.      +      200.0, 480.0, 0.0,
  59.      +      380.0, 180.0, 0.0,
  60.      +      250.0, 430.0, 0.0,
  61.      +      100.0, 130.0, 0.0,
  62.      +      50.0,  280.0, 0.0,
  63.      +      150.0, 380.0, 0.0
  64.      +  /
  65.  
  66.  
  67.     call winope('fcurves', 7)
  68. c
  69. c We'll use the SPACE bar to go to the next curve...
  70. c
  71.     call unqdev(INPUTC)
  72.     call qdevic(SPACEK)
  73.  
  74.     call ortho2(-200.0, 400.0, -100.0, 500.0)
  75.  
  76.     call color(BLACK)
  77.     call clear()
  78.  
  79.     call color(YELLOW)
  80.  
  81. c
  82. c label the control points in geom1
  83. c
  84.     do 10 i = 1, 4
  85.         call cmov2(geom1(1, i), geom1(2, i))
  86.         write(buf, '(i1)')i
  87.         call charst(buf, nchars(buf))
  88. 10    continue
  89.                                  
  90. c
  91. c label the control points in geom2
  92. c
  93.     do 20 i = 1, 6
  94.         call cmov2(geom2(1, i), geom2(2, i))
  95.         write(buf, '(i1)')i
  96.         call charst(buf, nchars(buf))
  97. 20    continue
  98.  
  99. c
  100. c set the number of line segments appearing in each curve to 20
  101. c
  102.     call curvep(20)
  103.  
  104. c
  105. c define the basis matricies
  106. c
  107.     call defbas(1, bezier)
  108.     call defbas(2, cardin)
  109.     call defbas(3, bsplin)
  110.  
  111. c
  112. c set the current basis as a bezier basis
  113. c
  114.     call curveb(1)
  115.  
  116.     call color(RED)
  117.  
  118. c
  119. c draw a curve using the current basis matrix (bezier in this case)
  120. c and the control points in geom1
  121. c
  122.     call crv(geom1)
  123.  
  124.     call cmov2(70.0, 60.0)
  125.     call charst('Bezier Curve Segment', 20)
  126.  
  127.     call cmov2(-190.0, 450.0)
  128.     call charst('Three overlapping Bezier Curves', 31)
  129.  
  130. c
  131. c curven draws overlapping curve segments according to geom2, the
  132. c number of curve segments drawn is three less than the number of
  133. c points passed, assuming there are a least four points in the
  134. c geometry matrix (in this case geom2). This call will draw 3
  135. c overlapping curve segments in the current basis matrix - still
  136. c bezier.
  137. c
  138.     call crvn(6, geom2)
  139.  
  140.     idum = qread(val)
  141. c
  142. c    Eat the up event as well...
  143. c
  144.     idum = qread(val)
  145.  
  146. c
  147. c load in the cardinal basis matrix
  148. c
  149.     call curveb(2)
  150.  
  151.     call color(MAGENT)
  152.  
  153.     call cmov2(70.0, 10.0)
  154.     call charst('Cardinal Curve Segment', 22)
  155.  
  156. c
  157. c plot out a curve segment using the cardinal basis matrix
  158. c
  159.     call crv(geom1)
  160.  
  161.     call cmov2(-190.0, 400.0)
  162.     call charst('Three overlapping Cardinal Curves', 33)
  163.  
  164. c
  165. c now draw a bunch of them again.
  166. c
  167.     call crvn(6, geom2)
  168.  
  169.     idum = qread(val)
  170. c
  171. c    Eat the up event as well...
  172. c
  173.     idum = qread(val)
  174.  
  175. c
  176. c change the basis matrix again
  177. c
  178.     call curveb(3)
  179.  
  180.     call color(GREEN)
  181.  
  182.     call cmov2(70.0, -40.0)
  183.     call charst('Bspline Curve Segment', 21)
  184.  
  185. c
  186. c now draw our curve segment in the new basis...
  187. c
  188.     call crv(geom1)
  189.  
  190.     call cmov2(-190.0, 350.0)
  191.     call charst('Three overlapping Bspline Curves', 32)
  192.  
  193. c
  194. c ...and do some overlapping ones
  195. c
  196.     call crvn(6, geom2)
  197.  
  198.     idum = qread(val)
  199. c
  200. c    Eat the up event as well...
  201. c
  202.     idum = qread(val)
  203.  
  204.     call gexit
  205.  
  206.     end
  207. c
  208. c nchars
  209. c
  210. c return the real length of a string padded with blanks
  211. c
  212.     integer function nchars(str)
  213.     character *(*) str
  214.  
  215.     do 10 i = len(str), 1, -1
  216.         if (str(i:i) .ne. ' ') then
  217.             nchars = i
  218.             return
  219.         end if
  220. 10      continue
  221.  
  222.     nchars = 0
  223.  
  224.     return
  225.  
  226.     end
  227. c
  228. c ShowCi
  229. c
  230. c    show a ring of text
  231. c
  232.     subroutine ShowCi(r, str)
  233.     real r
  234.     character*(*) str
  235.  
  236.     real i, inc, x, y, a, pi
  237.     integer j
  238.     character*1 c
  239.     parameter (pi = 3.1415926535)
  240.  
  241.     j = 1
  242.     inc = 360.0 / nchars(str)
  243.  
  244.     do 10 i = 0, 360.0, inc
  245. c
  246. c calculate the next drawing position
  247. c
  248.         c = str(j:j)
  249.         x = r * cos(i * pi / 180.0)
  250.         y = r * sin(i * pi / 180.0)
  251.         call move2(x, y)
  252. c
  253. c calculate angle for next character
  254. c
  255.         a = 90.0 + i
  256. c
  257. c set the orientation of the next character
  258. c
  259.         call htexta(a)
  260. c
  261. c draw the character
  262. c
  263.         call hdrawc(c)
  264.         j = j + 1
  265. 10    continue
  266.  
  267.     end
  268.